Developer CD Series 1994…tember: Reference Library/Dev.CD Sep 94.toast/Periodicals/develop/develop Issue 11/develop 11 code/The NetWork Project/Examples (Sources)/NetSim/UToy.p

Text File | 1992-07-15 | 6.0 KB | 266 lines | [TEXT/MPS ]

UNIT UToy;
{© G. Sawitzki, StatLab Heidelberg 1991}
{File UToy. This is just a toy to give something to communicate}
INTERFACE

    USES
    MacUnits,{Types, Quickdraw, OSIntf, ToolIntf, PackIntf, SANE, }{ Standard Includes}
    StdTools, Generic,NetSimGlobal,histogramunit;

CONST
    cMaxToyData = 1000;
TYPE
    tToyPtr = ^tToyRecord;
    tToyRecord = RECORD
        col: RGBColor;
        id: str255;
        sorted:boolean;
        minval,maxval:real;
        mean,ssq:extended;
        test_stat:extended;
        nrData:integer;
        data: ARRAY[1..cMaxToyData] OF real;
    END;

VAR ToyRec: tToyPtr;
    ToySeed:extended;
PROCEDURE tToy_init(count:integer);
PROCEDURE tToy_nextToy(Generator:longint;count:integer;VAR ToyStat:extended);

FUNCTION tToy_drawtoy(PROCEDURE DrawWhatToDraw): PicHandle;
PROCEDURE tToy_DrawScatter;

    IMPLEMENTATION

PROCEDURE tToy_init(count:integer);
VAR
    i: integer;
BEGIN
    new(ToyRec);
    ToySeed:=tickCount;    {initialize random number generator}
    IF ToyRec<>NIL THEN
    WITH ToyRec^ DO
    BEGIN
        IF count < cMaxToyData THEN nrData:=count
        ELSE count:=cMaxToyData;
        WITH col DO
        BEGIN
            red := random;
            green := random;
            blue := random;
        END;
        numtostring(random, id);
        FOR i := 1 TO nrData DO
        data[i] := random;
        sorted:=false;
    END;
END;

FUNCTION CurStat:extended;
VAR tempval:extended;
BEGIN
    IF toyrec=NIL THEN CurStat:=0
    ELSE WITH ToyRec^ DO BEGIN
        tempval:=(maxval-minval)/sqrt(ssq);
        IF (ClassExtended(tempval) IN [SNAN,QNAN,Infinite]) THEN  SysBreakStr('bad CurStat value');
        CurStat:=tempval;
    END;
END;

PROCEDURE getstat;
VAR stat:tStatType;
    i:integer;
BEGIN
    initStat(stat,'');
    IF ToyRec<>NIL THEN
    WITH ToyRec^ DO BEGIN
        FOR i := 1 TO nrData DO
        addstat(data[i],stat);
        minval:=stat.min;
        maxval:=stat.max;
        mean:=stat.mean;
        ssq:=stat.ssq;
    END;
END;

PROCEDURE tToy_nextToy(Generator:longint;count:integer;VAR ToyStat:extended);

{$IFC false}
MPW Pascal does not understand type casting in CONST clause:

CONST cUNIF=longint('UNIF');
#                  ?
### pascal - Error 101 Identifier not of the appropriate class
### Error 102 Identifier not declared
#                   ?
### Error 20 Illegal symbol
#--------------------------------------------------------------------------------------------------------------------------------
    File "UToy.p"; Line 86
#--------------------------------------------------------------------------------------------------------------------------------
### MPW Shell (3.3) - Execution of BuildProgram terminated.
{$ENDC}

VAR
    i: integer;
    u1,u2,l,x:extended;
BEGIN
    IF ToyRec<>NIL THEN
    WITH ToyRec^ DO BEGIN
        IF count < cMaxToyData THEN nrData:=count
        ELSE count:=cMaxToyData;

{$IFC False}
{MPW Pascal cannot handle typecasting in case statements. So we
have to use a chain of if-statements}

        case Generator of
        longint('UNIF') :...;
### pascal - Error 101 Identifier not of the appropriate class
### Error 102 Identifier not declared
#               ?
### Error 20 Illegal symbol
#                        ?
### Error 142 Label type incompatible with selecting expression

        longint('GAUS') :...;
        longint('Cchy') :...;
        end;
{$ENDC}

        IF Generator =longint('UNIF') THEN {uniform distribution on -MaxLongInt...MaxLongInt}
        BEGIN
            FOR i := 1 TO nrData DO BEGIN
                data[i] := round(randomX(ToySeed));
            END;
            sorted:=false;
        END ELSE
        IF Generator =longint('GAUS') THEN {standard gaussian (normal) distribution}
        BEGIN
            FOR i := 1 TO nrData DIV 2 DO
            BEGIN
                {get two U(0,1) random numbers}
                u1:=((round(randomX(ToySeed))/maxlongint) +1)/2;
                u2:=((round(randomX(ToySeed))/maxlongint) +1)/2;
                l:=sqrt(-2 * ln(u1));
                data[i] := l * cos(2 * pi * u2);
                data[nrData+1-i] := l * sin(2 * pi * u2);
            END;
            sorted:=false;
        END ELSE
        IF Generator =longint('Cchy') THEN {cauchy distribution}
        BEGIN
            FOR i := 1 TO nrData DO BEGIN
                REPEAT
                    x := pi * ((((round(randomX(ToySeed)) / maxlongint) + 1) / 2) - 0.5);
                    data[i] := sin(x) / cos(x);{may run into cos(x)=0!}
                UNTIL     NOT (ClassExtended(data[i]) IN [SNAN,QNAN,Infinite]) ;
            END;
            sorted:=false;
        END ELSE Debugstr('Generator Unknown') {Noop & crash if Generator unknown} ;
        getstat;
        test_stat:=CurStat;
        ToyStat:=test_stat;

    END ELSE ToyStat:=0;
END;


PROCEDURE tToy_SortToy;

PROCEDURE quicksort(count:integer);
    {sort array a by key. count is nr of used entries in a }

VAR i:integer;

PROCEDURE sort(l,r:integer);
VAR i,j    : integer;
    x,w    : real;

BEGIN
    WITH ToyRec^ DO BEGIN
        i    := l; j    := r;
        x    := data(.(l+r) DIV    2.);
        REPEAT
            WHILE data(.i.) < x DO i := i + 1;
            WHILE x < data(.j.) DO j := j - 1;
            IF i <= j THEN
            BEGIN w := data(.i.); data(.i.) := data(.j.); data(.j.) :=    w;
                i := i +    1; j :=    j - 1
            END
        UNTIL i >    j;

        IF l < j THEN sort(l,j);
        IF i < r THEN sort(i,r);
    END;
END;  (* sort *)

BEGIN sort(1,count);
END;   (* quicksort *)



BEGIN
    WITH ToyRec^ DO
    IF NOT sorted THEN BEGIN
        quicksort(nrData);
        sorted:=true;
    END;
END;

PROCEDURE tToy_DrawScatter;
VAR i:integer;
    val,range,minrange:real;
    s:str255;
BEGIN
    WITH ToyRec^ DO BEGIN
        IF sorted THEN BEGIN
            minval:=data[1];
            maxval:=data[nrData];
        END ELSE BEGIN
            minval:=maxint;
            maxval:=-maxint-1;
            WITH ToyRec^ DO FOR i:=1 TO nrData DO BEGIN
                IF data[i]<minval THEN minval:=data[i];
                IF data[i]>=maxval THEN maxval:=data[i];
            END;
        END;
        range:=maxval;range:=range-minval;IF range=0 THEN range:=1;
        minrange:=minval-0.1*range;
        range:=300/(range*1.2);
        numtostring(round(range),s);


        FOR i := 1 TO nrData DO BEGIN
            val:=(data[i]-minrange)*range;
            moveto(round(val), 10);
            line(0, 80);
        END;
    END;
END;

FUNCTION tToy_drawtoy(PROCEDURE DrawWhatToDraw): PicHandle;
VAR
    myframe: rect;
    p: PicHandle;
    i: integer;
    oldCol: RGBColor;
    val:real;
    minrange,range:real;
    minval,maxval:integer;s:str255;
BEGIN
    IF ToyRec=NIL THEN tToy_drawtoy:=NIL ELSE BEGIN


        GetForeColor(OldCol);
        RGBForeColor(ToyRec^.col);
        setrect(myFrame, 0, 0, ToyRec^.nrData, 100);
        P := OpenPicture(myframe);

        DrawWhatToDraw;

        ClosePicture;
        RGBForeColor(Oldcol);
        tToy_drawtoy := p;
    END;{<>nil}
END;
END.